-- Haskore Live!
--
-- David Siegel <djsiegel@seas.upenn.edu>
-- Jonathan Coveney <jcoveney@wharton.upenn.edu>
--
-- Main.hs
--

-- | Module 'Main' gets the show on the road, and hosts the main event loop, and
-- the routines executed from the main event loop.
module Main where

import Char
import System.IO
import Test.HUnit
import Data.List (partition)
import Control.Monad.State
import qualified System (exitWith, ExitCode (ExitSuccess))

import TrackState
import qualified Keys
import qualified Base
import qualified Beats
import qualified Track
import qualified Routine
import qualified Performer
import qualified Interaction
import qualified PMidiPerformer
import PerformerConfig (performer)
import qualified HaskoreUtil as Haskore

-- | Initialize Haskore Live and enter the main TrackState event loop.
main = do
    putStrLn "Welcome to Haskore Live!"

    -- Initialize buffering.
    hSetBuffering stdout LineBuffering
    hSetBuffering stdin LineBuffering

    -- Initialize modules.
    Keys.init
    Performer.init performer

    -- Execute main event loop in TrackState monad.
    execTrackState trackLoop
    
    return ()

-- | Main event loop in TrackState:
--
--      1. Prompt user for a command line.
--      2. Parse command line, look up appropriate routine.
--      3. Execute routine, passing command line arguments.
--      4. Goto 1 (or quit if user presses enter).
--
trackLoop :: TrackState ()
trackLoop = do
    -- Create base Track and add it to Track stack.
    let perf  = Haskore.musicToPerformance Base.base
    let track = Track.T "Base track" perf
    pushTrack track

    -- Get user commands and execute appropriate routines.
    forever $ do
        line <- lift $ do putStr "> "; hFlush stdout
                          getLine
        case words line of
            (cmd:argv) ->
                case Routine.lookupF cmd routines of
                    Just f  -> f argv
                    Nothing -> rError argv

            []      -> rQuit []

-- | 'routines' uses 'Routine.T' from the 'Routine' module to provide user
-- commands in an extensible and centralized way. This makes adding and removing
-- functionality very simple; adding a routine instantly makes it accessible via
-- the command line, and information about the routine is available from the
-- 'help' command.
routines :: [Routine.T TrackState]
routines = [ Routine.T "about"
                "Displays information about the program"
                Nothing
                rAbout
            , Routine.T "help"
                "Displays a list of commands"
                Nothing
                rUsage
            , Routine.T "perform"
                "Goes into live music mode. Improvisations are recorded"
                Nothing
                (rPerform True)
            , Routine.T "rehearse"
                "Goes into rehearsal mode. Improvisations are not recorded"
                Nothing
                (rPerform False)
            , Routine.T "beat"
                "Adds a user defined beat to the currently performance"
                (Just "beat \"<instrument>\" <beat string> ")
                rBeat
            , Routine.T "instruments"
                "List available instruments"
                Nothing
                rInstruments
            , Routine.T "ls"
                "Lists current tracks"
                Nothing
                rList
            , Routine.T "rm"
                "Remove a track"
                (Just "rm <track number>")
                rRemove
            , Routine.T "mv"
                "(Re)name a track"
                (Just "mv <track number> <track name>")
                rRename
            , Routine.T "quit"
                "Quits the program"
                Nothing
                rQuit
            ]

-- | Plays a single loop of the current tracks, adding a new Track to the
-- TrackState if the user has improvised a new Performance. The boolean argument
-- determines whether or not the improvised Performance should be recorded and
-- saved.
rPerform :: Bool -> Routine.Argv -> TrackState ()
rPerform rec argv = do
    ps     <- liftM (map Track.performance) getTracks
    p      <- lift $ Interaction.improvLoop ps
    if rec && p /= []
        then pushTrack $ Track.T "Live performance" p
        else return ()

-- | On erroneous input, notifies the user of the mistake and of the help
-- command.
rError :: Routine.Argv -> TrackState ()
rError argv = do
    lift $ putStrLn "Invalid command. Type 'help' for help."

-- | Returns the description of the program.
rAbout :: Routine.Argv -> TrackState ()
rAbout _ = do 
    lift $ mapM_ putStrLn $
        [ "    __  __           __                      __    _"
        , "   / / / /___ ______/ /______  ________     / /   (_)   _____"
        , "  / /_/ / __ `/ ___/ //_/ __ \\/ ___/ _ \\   / /   / / | / / _ \\"
        , " / __  / /_/ (__  ) ,< / /_/ / /  /  __/  / /___/ /| |/ /  __/"
        , "/_/ /_/\\__,_/____/_/|_|\\____/_/   \\___/  /_____/_/ |___/\\___/"
        , ""
        , "     Composed by David \"Die, MIDI, die!\" Siegel"
        , "           And Jonthan \"More MIDI, please!\" Coveney"
        , ""
        , "   Why shouldn't Music in Haskell be easy?"
        , "         Because Hudak said so!"
        , ""
        , "Built on top of the Haskore music system"
        , "Live music generator turns your keyboard into a synth"
        , "and lets you manage beats. It's fun...we promise!"
        , ""
        , "   Written for Benjamin Pierce"
        , "        CIS 552 under the MIT License"
        ]

-- | Uses the Beat parser in 'Beats' to create a beat which is then added to the
-- TrackState.
rBeat :: Routine.Argv -> TrackState ()
rBeat args = let (instr, bstr) = head (reads $ unwords args :: [(String, String)])
                 music         = Beats.music instr 3 $ dropWhile isSpace bstr 
                 performance   = Haskore.musicToPerformance music
                 isInstrument  = any (==instr) Haskore.allInstruments
             in if isInstrument
                  then pushTrack $ Track.T instr performance 
                  else lift $ putStrLn "Improper instrument."

-- | Prints all instruments available for use with beat command.
rInstruments :: Routine.Argv -> TrackState ()
rInstruments args = lift $ do
    mapM_ putStrLn cols
    where padR n s      = s ++ replicate (n - length s) ' '
          (long, short) = partition (\x -> length x > 15) Haskore.allInstruments
          narrow        = map (padR 20) short
          wide          = map (padR 40) long
          groupsOf _ [] = []
          groupsOf n xs = concat (take n xs) : groupsOf n (drop n xs)
          cols          = groupsOf 4 narrow ++ groupsOf 2 wide

-- | Prints usage information using Routines defined in routines.
rUsage :: Routine.Argv -> TrackState ()
rUsage _ = lift $ do
    putStrLn "    ======== USAGE INFORMATION ========="
    mapM_ (putStrLn . show) routines
    putStrLn "Press RETURN to exit."

-- | Lists current tracks.
rList :: Routine.Argv -> TrackState ()
rList argv = do
    ts <- getTracks
    -- Iterate over a numbered list of tracks, printing each one.
    forM_ (zip [1..] ts) $ \(i, t) -> lift $ do
        putStrLn $ show i ++ " - " ++ show t

-- | Removes a track.
rRemove :: Routine.Argv -> TrackState ()
rRemove argv = do
    max <- countTracks    
    if length argv < 1
        then do
            usage
        else do
            case reads (head argv) of
                [(i,_)] -> do
                    valid <- validateIndex (i-1)
                    if valid
                        then removeTrack (i-1) >> return ()
                        else lift $ putStrLn "Invalid track number."
                _       -> usage
    where usage = lift $ putStrLn "Usage: rm <track number>"

-- | Renames a track.
rRename :: Routine.Argv -> TrackState ()
rRename argv = do
    max <- countTracks    
    if length argv < 2
        then do
            usage
        else do
            case reads (head argv) of
                [(i,_)] -> do
                    valid <- validateIndex (i-1)
                    if valid
                        then nameTrack (i-1) (unwords (tail argv))
                        else lift $ putStrLn "Invalid track number."
                _       -> usage
    where usage = lift $ putStrLn "Usage: mv <track number> <track name>"

-- | Exits the program, printing a friendly farewell.
rQuit :: Routine.Argv -> TrackState ()
rQuit _ = lift $ do
    putStrLn "Goodbye!"
    Performer.destroy performer
    System.exitWith System.ExitSuccess

-- | Runs unit tests for all Haskore Live modules.
--
-- Some trivial modules do not contain tests, and some non-trivial modules also
-- do not contain tests. In both cases, we have often chosen to setup empty
-- runTests functions in those modules to facilitate the addition of new tests.
-- In non-trivial modules without tests, we usually provide a comment as to why
-- unit testing was not appropriate or not feasible for those modules.
runAllTests = do
    Base.runTests
    Beats.runTests
    Haskore.runTests
    Interaction.runTests
    Keys.runTests
    PMidiPerformer.runTests
    Routine.runTests
    TrackState.runTests

    return ()
